home *** CD-ROM | disk | FTP | other *** search
/ Games of Daze / Infomagic - Games of Daze (Summer 1995) (Disc 1 of 2).iso / x2ftp / msdos / source / gfxfx / copper5.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-05-28  |  1.3 KB  |  56 lines
  1.  
  2. program copper;
  3. { Real-time color-mix-copper (5), by Bas van Gaalen, Holland, PD }
  4. uses crt;
  5. const size=350; step=25; bars=3;
  6. var
  7.   pal:array[0..3*size-1] of byte;
  8.   stab:array[0..255] of word;
  9.   bartab:array[0..bars-1] of word;
  10.  
  11. procedure createtab; var i:byte; begin
  12.   for i:=0 to 255 do stab[i]:=round(sin(2*pi*i/255)*105)+112; end;
  13.  
  14. procedure movebars;
  15. var n,i:word;
  16. begin
  17.   fillchar(pal[6],3*size-13,0);
  18.   for n:=0 to bars-1 do begin
  19.     for i:=0 to 63 do pal[n mod 3+3*stab[bartab[n]]+3*i]:=i;
  20.     for i:=0 to 63 do pal[n mod 3+3*stab[bartab[n]]+3*64+3*i]:=63-i;
  21.     bartab[n]:=1+bartab[n] mod 255;
  22.   end;
  23. end;
  24.  
  25. procedure copperbars;
  26. var cc,l:word;
  27. begin
  28.   asm cli end;
  29.   while (port[$3da] and 8) <> 0 do;
  30.   while (port[$3da] and 8) = 0 do;
  31.   cc:=0;
  32.   for l:=0 to size-1 do begin
  33.     port[$3c8]:=0;
  34.     port[$3c9]:=pal[cc];
  35.     port[$3c9]:=pal[cc+1];
  36.     while (port[$3da] and 1) <> 0 do;
  37.     while (port[$3da] and 1) = 0 do;
  38.     port[$3c9]:=pal[cc+2];
  39.     inc(cc,3);
  40.   end;
  41.   asm sti end;
  42. end;
  43.  
  44. var i:byte;
  45. begin
  46.   fillchar(pal,sizeof(pal),0);
  47.   for i:=0 to bars-1 do bartab[i]:=step*i;
  48.   pal[3*size-6]:=50; pal[3*size-5]:=50; pal[3*size-4]:=50;
  49.   pal[3]:=50; pal[4]:=50; pal[5]:=50;
  50.   createtab;
  51.   repeat
  52.     movebars;
  53.     copperbars;
  54.   until keypressed;
  55. end.
  56.